home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / additionals / Photo < prev    next >
Encoding:
Text File  |  1994-01-26  |  14.3 KB  |  424 lines
  1. # Program: xf
  2. # Description: handle photo widgets
  3. #
  4. # $Header: Photo[2.4] Wed Mar 10 11:57:26 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. global photoList
  8.  
  9. set xfDefaultConf(photo) 4
  10. if {![info exists photoList]} {
  11.   set photoList(xfnone) ""
  12. }
  13.  
  14. ##########
  15. # Procedure: XFAdd.Photo
  16. # Description: add a photo
  17. # Arguments: xfW - the widget
  18. #            xfName - a optional name
  19. #            xfType - add or config
  20. # Returns: none
  21. # Sideeffects: none
  22. ##########
  23. proc XFAdd.Photo {xfW xfName xfType} {
  24.   global xfConf
  25.   global xfStatus
  26.  
  27.   XFEditSetStatus "Inserting Photo..."
  28.   set xfName [XFMiscGetUniqueName $xfName photo]
  29.   if {"$xfStatus(path)" == "."} {
  30.     if {"$xfType" == "add"} {
  31.       if {[catch "photo .$xfName" xfResult]} {
  32.         XFProcError "$xfResult"
  33.         XFEditSetStatus "Inserting Photo...aborted"
  34.         return
  35.       }
  36.     } {
  37.       if {[catch "photo .$xfName" xfResult]} {
  38.         XFProcError "$xfResult"
  39.         XFEditSetStatus "Inserting Photo...aborted"
  40.         return
  41.       }
  42.     }
  43.  
  44.     XFMiscPositionWidget .$xfName
  45.     XFMiscBindWidgetTree .$xfName
  46.   } {
  47.     if {"$xfType" == "add"} {
  48.       if {[catch "photo $xfStatus(path).$xfName" xfResult]} {
  49.         XFProcError "$xfResult"
  50.         XFEditSetStatus "Inserting Photo...aborted"
  51.         return
  52.       }
  53.     } {
  54.       if {[catch "photo $xfStatus(path).$xfName" xfResult]} {
  55.         XFProcError "$xfResult"
  56.         XFEditSetStatus "Inserting Photo...aborted"
  57.         return
  58.       }
  59.     }
  60.  
  61.     XFMiscPositionWidget $xfStatus(path).$xfName
  62.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  63.   }
  64.  
  65.   incr xfStatus(elementCounter)
  66.   XFEditSetPath $xfStatus(path)
  67.   XFEditSetStatus "Inserting Photo...done"
  68. }
  69.  
  70. ##########
  71. # Procedure: XFBind.Photo
  72. # Description: default bindings for photo
  73. # Arguments: xfW - the widget
  74. # Returns: none
  75. # Sideeffects: none
  76. ##########
  77. proc XFBind.Photo {xfW} {
  78.  
  79.   if {"[info commands $xfW]" != ""} {
  80.     bind $xfW <2> {%W scan mark %x %y}
  81.     bind $xfW <B2-Motion> {%W scan dragto %x %y}
  82.   }
  83. }
  84.  
  85. ##########
  86. # Procedure: XFConfig.Photo4
  87. # Description: configure a photo
  88. # Arguments: xfW - the widget
  89. #            xfType - config type (add config)
  90. #            xfClass - the class we configure
  91. #            xfLeader - the leading window
  92. # Returns: none
  93. # Sideeffects: none
  94. ##########
  95. proc XFConfig.Photo4 {xfW xfType xfClass {xfLeader ""}} {
  96.   global photoList
  97.   global xfBind
  98.   global xfMisc
  99.   global xfStatus
  100.  
  101.   set xfMisc(photoDither) 0
  102.  
  103.   if {"$xfType" == "add"} {
  104.     set xfName button$xfStatus(elementCounter)
  105.   } {
  106.     set xfName [XFMiscPathName $xfW]
  107.   }
  108.   XFEditSetStatus "Calling parameter setting for Photo..."
  109.  
  110.   # build widget structure
  111.   XFTmpltToplevel .xf${xfClass}Config4 530x470 \
  112.     "Photo parameters:[XFMiscPathTail $xfW]" $xfLeader
  113.  
  114.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass XFPhotoSetPhoto4 \
  115.     parameters $xfName 4
  116. #  XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  117. #    background Background "Background" XFPhotoSetPhoto4
  118.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass blank \
  119.     blank Blank "Blank" XFPhotoSetPhoto4
  120. #  XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass borderwidth \
  121. #    borderWidth BorderWidth "Border width" "pixels" 40 XFPhotoSetPhoto4
  122.  
  123.   XFTmpltFrame .xf${xfClass}Config4.params1.params2.frame2 0
  124.   
  125.   label .xf${xfClass}Config4.params1.params2.frame2.message1 \
  126.     -anchor e \
  127.     -width $xfStatus(elementWidth) \
  128.     -text "Dither:"
  129.  
  130.   radiobutton .xf${xfClass}Config4.params1.params2.frame2.no \
  131.     -text "No" \
  132.     -value 0 \
  133.     -variable xfMisc(photoDither) \
  134.     -command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  135.  
  136.   radiobutton .xf${xfClass}Config4.params1.params2.frame2.request \
  137.     -text "On request" \
  138.     -value 1 \
  139.     -variable xfMisc(photoDither) \
  140.     -command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  141.  
  142.   radiobutton .xf${xfClass}Config4.params1.params2.frame2.always \
  143.     -text "Always" \
  144.     -value 2 \
  145.     -variable xfMisc(photoDither) \
  146.     -command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  147.  
  148.   pack append .xf${xfClass}Config4.params1.params2.frame2 \
  149.               .xf${xfClass}Config4.params1.params2.frame2.message1 {left} \
  150.               .xf${xfClass}Config4.params1.params2.frame2.no {left} \
  151.               .xf${xfClass}Config4.params1.params2.frame2.request {left} \
  152.               .xf${xfClass}Config4.params1.params2.frame2.always {left}
  153.   pack append .xf${xfClass}Config4.params1.params2 \
  154.               .xf${xfClass}Config4.params1.params2.frame2 {top fillx}
  155.  
  156.   XFElementGeometry $xfW .xf${xfClass}Config4 $xfType $xfClass \
  157.     XFPhotoSetPhoto4
  158.   XFElementScaleDouble $xfW .xf${xfClass}Config4 $xfType \
  159.     $xfClass size "Image size" "Width" "Height" 2000 2000
  160.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass gamma \
  161.     gamma Gamma "Gamma" "Gamma/10" 100 XFPhotoSetPhoto4
  162.  
  163.   XFTmpltFrame .xf${xfClass}Config4.params1.params2.frame3 0
  164.   
  165.   label .xf${xfClass}Config4.params1.params2.frame3.message1 \
  166.     -anchor e \
  167.     -width $xfStatus(elementWidth) \
  168.     -text "Palette:"
  169.  
  170.   scale .xf${xfClass}Config4.params1.params2.frame3.bw \
  171.     -from 0 \
  172.     -label "Gray shades" \
  173.     -orient horizontal \
  174.     -sliderlength 15 \
  175.     -to 256 \
  176.     -width 8
  177.  
  178.   scale .xf${xfClass}Config4.params1.params2.frame3.red \
  179.     -from 0 \
  180.     -label "Red" \
  181.     -orient horizontal \
  182.     -sliderlength 15 \
  183.     -to 256 \
  184.     -width 8
  185.  
  186.   scale .xf${xfClass}Config4.params1.params2.frame3.green \
  187.     -from 0 \
  188.     -label "Green" \
  189.     -orient horizontal \
  190.     -sliderlength 15 \
  191.     -to 256 \
  192.     -width 8
  193.  
  194.   scale .xf${xfClass}Config4.params1.params2.frame3.blue \
  195.     -from 0 \
  196.     -label "Blue" \
  197.     -orient horizontal \
  198.     -sliderlength 15 \
  199.     -to 256 \
  200.     -width 8
  201.  
  202.   pack append .xf${xfClass}Config4.params1.params2.frame3 \
  203.               .xf${xfClass}Config4.params1.params2.frame3.message1 {left} \
  204.               .xf${xfClass}Config4.params1.params2.frame3.bw {left} \
  205.               .xf${xfClass}Config4.params1.params2.frame3.red {left} \
  206.               .xf${xfClass}Config4.params1.params2.frame3.green {left} \
  207.               .xf${xfClass}Config4.params1.params2.frame3.blue {left}
  208.   pack append .xf${xfClass}Config4.params1.params2 \
  209.               .xf${xfClass}Config4.params1.params2.frame3 {top fillx}
  210.  
  211. #  XFElementRelief $xfW .xf${xfClass}Config4 $xfType $xfClass XFPhotoSetPhoto4
  212.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass xscrollcommand \
  213.     xscrollcommand XScrollCommand "X scroll command" XFPhotoSetPhoto4
  214.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass yscrollcommand \
  215.     yscrollcommand YScrollCommand "Y scroll command" XFPhotoSetPhoto4
  216.  
  217.   set xfTmpRetVal ""
  218.   if {![info exists photoList]} {
  219.     set photoList(xfnone) ""
  220.   }
  221.   foreach xfCounter [array names photoList] {
  222.     if {"$xfCounter" == "$xfW"} {
  223.       set xfArrayName ""
  224.       append xfArrayName photoList ( $xfCounter )
  225.       if {[catch "set \"$xfArrayName\"" xfTmpRetVal]} {
  226.         set xfTmpRetVal ""
  227.       }
  228.     }
  229.   }
  230.   XFTmpltLabledEntry .xf${xfClass}Config4.params1.params2 picname \
  231.     "Picture name:" $xfTmpRetVal
  232.   XFMiscInitElement .xf${xfClass}Config4 picname
  233.   pack append .xf${xfClass}Config4.params1.params2 \
  234.               .xf${xfClass}Config4.params1.params2.picname {top fillx pady 6} \
  235.  
  236.   if {[llength [split [lindex [$xfW configure -palette] 4] /]] == 1} {
  237.     .xf${xfClass}Config4.params1.params2.frame3.bw set \
  238.       [lindex [$xfW configure -palette] 4]
  239.   } {
  240.     .xf${xfClass}Config4.params1.params2.frame3.red set \
  241.       [lindex [split [lindex [$xfW configure -palette] 4] /] 0]
  242.     .xf${xfClass}Config4.params1.params2.frame3.green set \
  243.       [lindex [split [lindex [$xfW configure -palette] 4] /] 1]
  244.     .xf${xfClass}Config4.params1.params2.frame3.blue set \
  245.       [lindex [split [lindex [$xfW configure -palette] 4] /] 2]
  246.   }
  247.  
  248.   if {"$xfType" == "add"} {
  249.     .xf${xfClass}Config4.params1.params2.gamma.gamma set 10
  250.   } {
  251.     .xf${xfClass}Config4.params1.params2.gamma.gamma set \
  252.       [lindex [split [expr [lindex [$xfW configure -gamma] 4]*10] .] 0]
  253.  
  254.     .xf${xfClass}Config4.leave.cancel configure \
  255.       -command "
  256.         global xfMisc
  257.         if {\[info exists xfMisc($xfClass,saveValue)\]} {
  258.           foreach xfCounter \$xfMisc($xfClass,saveValue) {
  259.             catch \"$xfW config -\[lindex \$xfCounter 0\] \\\"\[lindex \$xfCounter 1\]\\\"\"
  260.           }
  261.         }
  262.         if {\[info exists xfMisc($xfClass,saveWm)\]} {
  263.           if {\"[string tolower $xfClass]\" == \"toplevel\"} {
  264.             foreach xfCounter \$xfMisc($xfClass,saveWm) {
  265.               catch \"wm \[lindex \$xfCounter 0\] $xfW \\\"\[lindex \$xfCounter 1\]\\\"\"
  266.             }
  267.           }
  268.         }
  269.         if {\"\[.xf${xfClass}Config4.params1.params2.picname.picname get\]\" == \"\"} {
  270.           set xfArrayName \"\"
  271.           append xfArrayName photoList ( $xfW )
  272.           catch \"unset \\\"\$xfArrayName\\\"\"
  273.         } {
  274.           set xfArrayName \"\"
  275.           append xfArrayName photoList ( $xfW )
  276.           set \"\$xfArrayName\" \
  277.             \[.xf${xfClass}Config4.params1.params2.picname.picname get\]
  278.           $xfW blank
  279.           readppm $xfW \[set \"\$xfArrayName\"\]
  280.         }
  281.         destroy .xf${xfClass}Config4"
  282.   }
  283.  
  284.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.gamma.gamma \
  285.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  286.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.frame3.bw \
  287.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  288.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.frame3.red \
  289.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  290.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.frame3.green \
  291.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  292.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.frame3.blue \
  293.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  294.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.size.size1.size1 \
  295.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  296.   XFMiscSetResource .xf${xfClass}Config4.params1.params2.size.size2.size2 \
  297.     command "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  298.  
  299.   # save current parameter
  300. #  XFElementSave $xfW $xfClass {background borderwidth blank ditherlevel imagesize gamma geometry palette xscrollcommand yscrollcommand}
  301.   XFElementSave $xfW $xfClass {blank ditherlevel imagesize gamma geometry palette xscrollcommand yscrollcommand}
  302.  
  303.   bind .xf${xfClass}Config4.params1.params2.picname.picname $xfBind(configure) \
  304.     "XFProcFSBoxFile {.xf${xfClass}Config4.params1.params2.picname.picname}"
  305.   bind .xf${xfClass}Config4.params1.params2.picname.picname <Return> \
  306.     "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  307.  
  308.   # packing
  309.   pack append .xf${xfClass}Config4.params1 \
  310.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  311.   pack append .xf${xfClass}Config4 \
  312.               .xf${xfClass}Config4.pathname {top fill frame center} \
  313.               .xf${xfClass}Config4.leave {bottom fill} \
  314.               .xf${xfClass}Config4.additional {bottom fill} \
  315.               .xf${xfClass}Config4.params1 {top fill expand}
  316.  
  317.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  318.     "XFPhotoSetPhoto4 $xfW 0 $xfClass"
  319.  
  320.   XFEditSetStatus "Calling parameter setting for Photo...done"
  321. }
  322.  
  323. ##########
  324. # Procedure: XFSaveSpecial.Photo
  325. # Description: save photo
  326. # Arguments: xfW - the widget
  327. # Returns: none
  328. # Sideeffects: none
  329. ##########
  330. proc XFSaveSpecial.Photo {xfW} {
  331.   global photoList
  332.  
  333.   set xfResult ""
  334.   if {![info exists photoList]} {
  335.     set photoList(xfnone) ""
  336.   }
  337.   foreach xfCounter [array names photoList] {
  338.     if {"$xfCounter" == "$xfW"} {
  339.       set xfArrayName ""
  340.       append xfArrayName photoList ( $xfCounter )
  341.       if {![catch "set \"$xfArrayName\"" xfTmpRetVal]} {
  342.         append xfResult "  $xfW blank\n"
  343.         append xfResult "  readppm $xfW \"$xfTmpRetVal\"\n"
  344.       }
  345.     }
  346.   }
  347.   return $xfResult
  348. }
  349.  
  350. ##########
  351. # Procedure: XFPhotoSetPhoto4
  352. # Description: set photo parameters
  353. # Arguments: xfW - the widget
  354. #            xfType - the type of setting (1 = set always, 0 = set
  355. #                     only if permanent apply is on)
  356. #            xfClass - the class we configure
  357. #            xfParam1 - ignored parameter
  358. # Returns: none
  359. # Sideeffects: none
  360. ##########
  361. proc XFPhotoSetPhoto4 {xfW xfType xfClass {xfParam1 ""}} {
  362.   global photoList
  363.   global xfConf
  364.   global xfMisc
  365.  
  366.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  367.     return
  368.   }
  369.   if {"[info commands $xfW]" == ""} {
  370.     return
  371.   }
  372.   XFMiscSetSymbolicName $xfW \
  373.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  374.  
  375. #  XFMiscSetResource $xfW background \
  376. #    [.xf${xfClass}Config4.params1.params2.bg.bg get]
  377.   if {"[.xf${xfClass}Config4.params1.params2.blank.blank get]" != ""} {
  378.     XFMiscSetResource $xfW blank \
  379.       [.xf${xfClass}Config4.params1.params2.blank.blank get]
  380.   }
  381. #  XFMiscSetResource $xfW borderwidth \
  382. #    "[.xf${xfClass}Config4.params1.params2.borderwidth.borderwidth get]"
  383.   XFMiscSetResource $xfW ditherlevel $xfMisc(photoDither)
  384.   if {[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get] > 0 &&
  385.       [.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get] > 0} {
  386.     XFMiscSetResource $xfW geometry \
  387.       "[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get]x[.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get]"
  388.   }
  389.   if {[.xf${xfClass}Config4.params1.params2.size.size1.size1 get] > 0 &&
  390.       [.xf${xfClass}Config4.params1.params2.size.size2.size2 get] > 0} {
  391.     XFMiscSetResource $xfW imagesize \
  392.       "[.xf${xfClass}Config4.params1.params2.size.size1.size1 get]x[.xf${xfClass}Config4.params1.params2.size.size2.size2 get]"
  393.   }
  394.   XFMiscSetResource $xfW gamma \
  395.     [expr [.xf${xfClass}Config4.params1.params2.gamma.gamma get]/10]
  396.   if {[.xf${xfClass}Config4.params1.params2.frame3.bw get] > 0} {
  397.     XFMiscSetResource $xfW palette \
  398.       [.xf${xfClass}Config4.params1.params2.frame3.bw get]
  399.   } {
  400.     XFMiscSetResource $xfW palette \
  401.       ".xf${xfClass}Config4.params1.params2.frame3.red get]/.xf${xfClass}Config4.params1.params2.frame3.green get]/.xf${xfClass}Config4.params1.params2.frame3.blue get]"
  402.   }
  403.   XFMiscSetResource $xfW xscrollcommand \
  404.     [.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]
  405.   XFMiscSetResource $xfW yscrollcommand \
  406.     [.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]
  407.  
  408.   if {"[.xf${xfClass}Config4.params1.params2.picname.picname get]" ==""} {
  409.     set xfArrayName ""
  410.     append xfArrayName photoList ( $xfW )
  411.     catch "unset \"$xfArrayName\""
  412.   } {
  413.     set xfArrayName ""
  414.     append xfArrayName photoList ( $xfW )
  415.     set "$xfArrayName" \
  416.       [.xf${xfClass}Config4.params1.params2.picname.picname get]
  417.     $xfW blank
  418.     readppm $xfW [set "$xfArrayName"]
  419.   }
  420. }
  421.  
  422. # eof
  423.  
  424.